Macwelt 1

home *** CD-ROM | disk | FTP | other *** search

/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / schemeMode.tcl < prev next >

Wrap

Text File | 2000-12-07 | 22.5 KB | 681 lines

## -*-Tcl-*- (nowrap) # ========================================================================== # Lisp Mode - an extension package for Alpha # # FILE: "schemeMode.tcl" # created: 07/03/96 {02:19:49 pm} # last update: 12/07/00 {03:46:32 pm} # Description: # # A mode for the shareware program Alpha, for Scheme files. # # Original by Oleg Kiselyov (oleg@ponder.csci.unt.edu) # # Updated by Craig Barton Upright # # E-mail: <cupright@princeton.edu> # mail: Princeton University, Department of Sociology # Princeton, New Jersey 08544 # www: <http://www.princeton.edu/~cupright> # # Craig will maintain this until somebody else steps forward. # # ------------------------------------------------------------------- # # Copyright (c) 1996-2000 Oleg Kiselyov, Craig Barton Upright # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # ========================================================================== ## # =========================================================================== # # ◊◊◊◊ Initialization of Scm mode ◊◊◊◊ # # alpha::mode Scm 2.0 schemeMode.tcl {*.scm} { lispMenu electricReturn electricTab electricBraces } { # We require 7.4b21 for prefs handling. alpha::package require AlphaTcl 7.4b21 } uninstall { catch {file delete [file join $HOME Tcl Modes schemeMode.tcl]} catch {file delete [file join $HOME Tcl Completions ScmCompletions.tcl]} } help { The Scheme dialect of Lisp was created in 1975 by Guy Steele and Gerry Sussman to explore ideas in programming-language semantics. They showed that a powerful language can be made "not by piling feature on top of feature, but by removing the weaknesses and restrictions that make additional features appear necessary". Scheme pioneered lexical scope in Lisp, first-class continuations, and tail recursion, and more recently added an advanced macro system. It's the best-known Lisp dialect after Common Lisp (which it influenced). It is IEEE standardized and widely used in universities and in electronic CAD systems. -- <http://www.lisp.org> Alpha's Scheme mode includes a user-expandable dictionary of keywords, a full set of electric completions, and a sophisticated indentation procedure. Normal features include Electric Return, Tab, and Braces. Scm mode also uses the Lisp menu. Click on this "Scheme Example.scm" link for an example syntax file. For more information about the Lisp menu, see "Lisp Help". } maintainer { "Craig Barton Upright" <cupright@princeton.edu> <http://www.princeton.edu/~cupright/> } proc schemeMode.tcl {} {} namespace eval Scm {} # =========================================================================== # # ◊◊◊◊ Setting Scm mode variables ◊◊◊◊ # # #============================================================================= # # Standard preferences recognized by various Alpha procs # newPref var fillColumn {75} Scm newPref var indentationAmount {4} Scm newPref var leftFillColumn {0} Scm newPref var prefixString {;; } Scm newPref var wordBreak {[\w\-]+} Scm newPref var wordBreakPreface {([^\w\-])} Scm newPref flag wordWrap {0} Scm # newPref v wordBreakPreface {[ \t\r\n]} Scm #============================================================================= # # Flag preferences # # Indent all continued commands, indicated by unmatched parantheses, by the # full indentation amount rather than half. newPref flag fullIndent {1} Scm newPref flag autoMark {0} Scm #============================================================================= # # Variable preferences # # Enter additional arguments to be colorized. newPref var addArguments {} Scm {Scm::colorizeScm} # Enter additional Scm commands to be colorized. newPref var addCommands {} Scm {Scm::colorizeScm} # Command double-clicking on a Lisp keyword will send it to this url # for a help reference page. newPref url schemeHelp {http://www.harlequin.com:8000/xanalys_int/query.html?qt=} Scm # =========================================================================== # # Color preferences # newPref color argumentColor {magenta} Scm {Scm::colorizeScm} newPref color commandColor {blue} Scm {Scm::colorizeScm} newPref color commentColor {red} Scm {stringColorProc} newPref color stringColor {green} Scm {stringColorProc} newPref color symbolColor {magenta} Scm {Scm::colorizeScm} regModeKeywords -e {;} \ -c $ScmmodeVars(commentColor) \ -s $ScmmodeVars(stringColor) Scm {} # ========================================================================== # # Comment Character variables for Comment Line / Paragraph / Box menu items. # set Scm::commentCharacters(General) ";; " set Scm::commentCharacters(Paragraph) [list ";; " " ;;" " ; "] set Scm::commentCharacters(Box) [list ";" 2 ";" 2 ";" 3] set ScmCommentRegexp {;.*$} set ScmPreRegexp {^\#[\t ]*[a-z]*} # =========================================================================== # # ◊◊◊◊ Keyword Dictionaries ◊◊◊◊ # # # Making sure that ScmUserCommands and ScmUserArguments exist. # These will be over-ridden if they are loaded from a ${mode}Prefs.tcl file. # set ScmUserCommands "" set ScmUserArguments "" set ScmCommands { abs and append apply assoc assq assv begin caar cadr call-with-current-continuation car case cdar cddr cdr cond cons declare define define-macro delay do else exact->inexact for-each if inexact->exact lambda length let let* letrec list list-refmake-vector map member memq memv number->string or peek-char read-char reverse set! set-car! set-cdr! string string->number string-append string-length string-ref string-set! substring vector vector-length vector-ref vector-set! } set ScmArguments { #f #t char? eof-object? eq? equal? eqv? even? list? negative? not null? odd? pair? positive? procedure? string=? zero? } # =========================================================================== # # Colorize Scm. # # Used to update preferences, and could be called in a <mode>Prefs.tcl file # proc Scm::colorizeScm {{pref ""}} { global ScmmodeVars ScmCommands ScmArguments ScmUserCommands ScmUserArguments global ScmCommandList Scmcmds # First setting aside only the commands, for Scm::Completion::Command. set ScmCommandList [concat \ $ScmCommands $ScmmodeVars(addCommands) $ScmUserCommands \ ] # Then, create the list of all keywords for completions. set Scmcmds [lsort [lunique [concat \ $ScmCommandList $ScmArguments \ $ScmmodeVars(addArguments) $ScmUserArguments \ ]]] # Commmands regModeKeywords -a -k $ScmmodeVars(commandColor) \ Scm $ScmCommandList # Arguments set ScmArgumentColorList [concat \ $ScmArguments $ScmmodeVars(addArguments) $ScmUserArguments] regModeKeywords -a \ -k $ScmmodeVars(argumentColor) Scm $ScmArgumentColorList # Symbols regModeKeywords -a \ -k $ScmmodeVars(symbolColor) Scm {} \ -i "+" -i "-" -i "*" -i "_" -i "\\" "/" \ -I $ScmmodeVars(symbolColor) if {$pref != ""} {refresh} } # Call this now. Scm::colorizeScm # =========================================================================== # # ◊◊◊◊ Key Bindings, Electrics ◊◊◊◊ # # # abbreviations: <o> = option, <z> = control, <s> = shift, <c> = command # # Known bug: Key-bindings from other global menus might conflict with those # defined in the Lisp menu. This will help ensure that this doesn't happen. Bind 's' <cs> {Lisp::switchToLisp} Scm Bind 'p' <cs> {Lisp::processFile} Scm Bind 'p' <csz> {Lisp::processSelection} Scm Bind 'n' <sz> {Lisp::nextCommand} Scm Bind 'p' <sz> {Lisp::prevCommand} Scm Bind 's' <sz> {Lisp::selectCommand} Scm Bind 'c' <sz> {Lisp::copyCommand} Scm Bind 'i' <cz> {Lisp::reformatCommand} Scm Bind '\r' <z> {typeText "\r" } Scm Bind '\r' <s> {Lisp::continueCommand} Scm Bind '\)' {Scm::electricRight "\)"} Scm # For those that would rather use arrow keys to navigate. Up and down # arrow keys will advance to next/prev command, right and left will also # set the cursor to the top of the window. Bind up <sz> {Lisp::prevCommand} Scm Bind left <sz> {Lisp::prevCommand 0 1} Scm Bind down <sz> {Lisp::nextCommand} Scm Bind right <sz> {Lisp::nextCommand 0 1} Scm proc Scm::carriageReturn {} { if {[isSelection]} { deleteSelection } set pos1 [lineStart [getPos]] set pos2 [getPos] if {[regexp {^([\t ])*\)} [getText $pos1 $pos2]]} { createTMark temp $pos2 Scm::indentLine gotoTMark temp ; removeTMark temp } insertText "\r" bind::IndentLine } proc Scm::electricRight {{char "\}"}} { set pos [getPos] typeText $char if {![regexp {[^ \t]} [getText [lineStart $pos] $pos]]} { set pos [lineStart $pos] createTMark temp [getPos] Scm::indentLine gotoTMark temp ; removeTMark temp bind::CarriageReturn } if {[catch {blink [matchIt $char [pos::math $pos - 1]]}]} { beep ; message "No matching $char !!" } } # =========================================================================== # # ◊◊◊◊ Indentation ◊◊◊◊ # # # Indenting a line of a Scheme code # # The idea is simple: the indent of a new line is the same as the indent of # the previous non-empty non-comment-only line *plus* the paren balance of # that line times two. # # That is, if the last code line was paren balanced, the next line would # have the same indent. If the prev line opened an expression but didn't # close it, the new line would be indented further # proc Scm::indentLine {{pos ""}} { if {[catch {Lisp::indentLine $pos}]} { Scm::indentLineOld } } proc Scm::correctIndentation {pos {next ""}} { Lisp::correctIndentation $pos $next } # This was the original procedure, with a little modification: proc Scm::indentLineOld {} { global mode indent_amounts ScmmodeVars set continueIndent [expr {$ScmmodeVars(fullIndent) + 1}] set beg [lineStart [getPos]] set end [nextLineStart [getPos]] # Find last previous non-comment line and get its leading whitespace set pos $beg set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ ;\t\r\n]} [pos::math $pos - 1]] set line [getText [lindex $lst 0] [pos::math [nextLineStart [lindex $lst 0]] - 1]] set lwhite [getText [lindex $lst 0] [pos::math [lindex $lst 1] - 1]] # Computing the balance of parentheses within the 'line': # # This appears to be utterly elementary. One has to keep in mind # however that parentheses might appear in comments and/or quoted # strings, in which case they shouldn't count. Although it's easy to # detect a Scheme comment by a semicolon, a semicolon can also appear # within a quoted string. Note that a double quote isn't that sure a # sign of a quoted string: the double quote may be escaped. And the # backslash can be escaped in turn... Thus we face a full-blown # problem of parsing a string according to a context-free grammar. We # note however that a TCL interpretor does similar kind of parsing all # the time. So, we can piggy-back on it and have it decide what is the # quoted string and when a semicolon really starts a comment. To this # end, we replace all non-essential characters from the 'line' with # spaces, separate all parens with spaces (so each paren would register # as a separate token with the TCL interpretor), replace a semicolon # with an opening brace (which, if unescaped and unquoted, acts as some # kind of "comment", that is, shields all symbols that follows). After # that, we get TCL interpretor to convert thus prepared 'line' into a # list, and simply count the balance of '(' and ')' tokens. # regsub -all -nocase {[^ ();\"\\]} $line { } line1 regsub -all {;} $line1 "\{" line regsub -all {[()]} $line { \0 } line1 set line_list [eval "list $line1 \}"] #alertnote ">$line_list<" set balance 0 foreach i $line_list { switch $i { ( {incr balance $continueIndent} ) {incr balance -continueIndent} } } #alertnote "balance $balance, lwhite [string length $lwhite]" if {$balance < 0} { set lwhite [string range $lwhite 0 [expr [string length $lwhite] + 2 * $balance - 1]] } else { append lwhite [string range " " 1 [expr 2 * $balance]] } #alertnote "new lwhite [string length $lwhite]" set text [getText $beg [nextLineStart $beg]] regexp {^[ \t]*} $text white set len [string length $white] if {$white != $lwhite} { replaceText $beg [pos::math $beg + $len] $lwhite } goto [pos::math $beg + [string length $lwhite]] return } # =========================================================================== # # ◊◊◊◊ Command Double Click ◊◊◊◊ # # # Checks to see if the highlighted word appears in any keyword list, and if # so, sends the selected word to the www.Lisp.com help site. # # Control-Command double click will insert syntax information in status bar. # Shift-Command double click will insert commented syntax information in window. # # (The above is not yet implemented -- need to enter all of the syntax info.) # proc Scm::DblClick {from to shift option control} { global ScmmodeVars Scmcmds ScmSyntaxMessage select $from $to set command [getSelect] set varDef "(def|make)+(\[-a-zA-Z0-9\]+(\[\t\' \]+$command)+\[\t\r\n \])" if {![catch {search -s -f 1 -r 1 -m 0 $varDef [minPos]} match]} { # First check current file for a function, variable (etc) # definition, and if found ... placeBookmark goto [lineStart [lindex $match 0]] message "press <Ctl .> to return to original cursor position" return # Could next check any open windows, or files in the current # window's folder ... but not implemented. For now, variables # (etc) need to be defined in current file. } if {[lsearch -exact $Scmcmds $command] == -1} { message "\"$command\" is not defined as a Scm system keyword." return } # Any modifiers pressed? if {$control} { # CONTROL -- Just put syntax message in status bar window if {[info exists ScmSyntaxMessage($command)]} { message "$ScmSyntaxMessage($command)" } else { message "Sorry, no syntax information available for $command" } } elseif {$shift} { # SHIFT --Just insert syntax message as commented text if {[info exists ScmSyntaxMessage($command)]} { endOfLine insertText "\r" insertText "$ScmSyntaxMessage($command) comment::Line } else { message "Sorry, no syntax information available for $command" } } else { # No modifiers -- Send command for on-line help. This is the # "default" behavior. Scm::wwwCommandHelp $command } } # =========================================================================== # # WWW Command Help # # Send command to defined url, prompting for text if necessary. # proc Scm::wwwCommandHelp {{command ""}} { global ScmmodeVars if {$command == ""} { set command [prompt "on-line help for ... " [getSelect]] # set command [statusPrompt "on-line help for ... " ] } message "\"$command\" sent to $ScmmodeVars(schemeHelp)" icURL $ScmmodeVars(schemeHelp)$command } # =========================================================================== # # ◊◊◊◊ Mark File and Parse Functions ◊◊◊◊ # # # =========================================================================== # # Scm Mark File # proc Scm::MarkFile {} { message "Marking File …" set count 0 set pos [minPos] set pat {^[ \t]*[$][#a-zA-z]*(define|define-[a-zA-Z]+) +[\(]*([^\($ \t\r\n]+)} while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $pat $pos} match]} { regexp -nocase -- $pat [eval getText $match] allofit defunname name set posBeg [lindex $match 0] set posEnd [nextLineStart $posBeg] if {[pos::math $posEnd > [maxPos]]} {set posEnd [maxPos]} setNamedMark $name $posBeg $posBeg $posBeg set pos $posEnd } message "" } # This was the original proc. # proc Scm::MarkFile {} { # # set pat1 {^[ \t]*[$][#a-zA-z]*(define|define-[a-zA-Z]+) +[\(]*([^\($ \t\r\n]+)} # set end [maxPos] # set pos [minPos] # set l {} # while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} { # regexp -nocase -- $pat1 [eval getText $mtch] allofit defunname name # set start [lindex $mtch 0] # set end [nextLineStart $start] # set pos $end # set inds($name) [lineStart [pos::math $start - 1]] # } # # if {[info exists inds]} { # foreach f [lsort -ignore [array names inds]] { # set next [nextLineStart $inds($f)] # setNamedMark $f $inds($f) $next $next # } # } # } # =========================================================================== # # Scm Parse Functions # # This will return only the Scm command names. # proc Scm::parseFuncs {} { global sortFuncsMenu set pos [minPos] set m {} while {[set match [search -s -f 1 -r 1 -i 0 -n {^\((\w+)} $pos]] != ""} { if {[regexp -- {(\w+)} [eval getText $match] "" word]} { lappend m [list $word [lindex $match 0]] } set pos [lindex $match 1] } if {$sortFuncsMenu} { regsub -all "\[\{\}\]" [lsort -ignore $m] "" m } else { regsub -all "\[\{\}\]" $m "" m } return $m } # =========================================================================== # # ◊◊◊◊ Help ◊◊◊◊ # # proc Scm::addKeywords {{category} {keywords ""}} { Lisp::LispModeMenuItem 0 1 global ScmmodeVars if {$keywords == ""} { set keywords [prompt "Enter new Scm mode $category:" ""] } # Check to see if the keyword is already defined. foreach keyword $keywords { set checkStatus [Scm::checkKeywords $keyword 1 0] if {$checkStatus != 0} { alertnote "Sorry, \"$keyword\" is already defined\ in the $checkStatus list." message "Cancelled." return -code return } } # Keywords are all new, so add them to the appropriate mode preference. append ScmmodeVars(add$category) " $keywords" set ScmmodeVars(add$category) [lsort $ScmmodeVars(add$category)] synchroniseModeVar add$category $ScmmodeVars(add$category) Scm::colorizeScm message "\"$keywords\" added to $category preference." } proc Scm::checkKeywords {{newKeywordList ""} {quietly 0} {noPrefs 0}} { Lisp::LispModeMenuItem 0 1 global ScmmodeVars global ScmCommands ScmUserCommands ScmUserArguments set type 0 if {$newKeywordList == ""} { set quietly 0 set newKeywordList [prompt "Enter Scm mode keywords to be checked:" ""] } # Check to see if the new keyword(s) is already defined. foreach newKeyword $newKeywordList { if {[lsearch -exact $ScmCommands $newKeyword] != "-1"} { set type ScmCommands } elseif {[lsearch -exact $ScmUserCommands $newKeyword] != "-1"} { set type ScmUserCommands } elseif {[lsearch -exact $ScmUserArguments $newKeyword] != "-1"} { set type ScmUserArguments } elseif {!$noPrefs && \ [lsearch -exact $ScmmodeVars(addCommands) $newKeyword] != "-1"} { set type ScmmodeVars(addCommands) } elseif {!$noPrefs && \ [lsearch -exact $ScmmodeVars(addArguments) $newKeyword] != "-1"} { set type ScmmodeVars(addArguments) } if {$quietly} { # When this is called from other code, it should only contain # one keyword to be checked, and we'll return it's type. return "$type" } elseif {!$quietly && $type == 0} { alertnote "\"$newKeyword\" is not currently defined\ as a Scm mode keyword" } elseif {$type != 0} { # This will work for any other value for "quietly", such as "2" alertnote "\"$newKeyword\" is currently defined as a keyword\ in the \"$type\" list." } set type 0 } } # =========================================================================== # # ◊◊◊◊ Navigation ◊◊◊◊ # # proc Scm::searchFunc {direction} { Lisp::LispModeMenuItem if {$direction} { Lisp::nextCommand } else { Lisp::prevCommand } } # =========================================================================== # # ◊◊◊◊ -------------------- ◊◊◊◊ # # # ◊◊◊◊ version history ◊◊◊◊ # # # modified by rev reason # -------- --- ------ ----------- # 10/01/96 ok 1.0 Original Scheme mode. # 03/18/99 ?? - 1.3 Updates. # 11/30/00 cbu 1.4 Updated to use the lispMenu better, including # Added Scm::colorizeScm # Added Scm::carriageReturn # Added Scm::electricRight # Revised Scm::indentLine # Added Scm::correctIndentation # Revised Scm::MarkFile # Added Scm::parseFuncs # Added Scm::checkKeywords # Added Scm::addKeywords # Added Scm::searchFunc # 12/01/00 cbu 2.0 New url prefs handling requires 7.4b21 # # =========================================================================== # # .